Programmers Heaven 2/Programmers Heaven 2.iso/files/windows/ocx/ver.exe/SA_SETUP.FRM

Visual Basic Form | 1994-05-01 | 13.9 KB | 472 lines

VERSION 2.00
Begin Form Form1
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Setup Apprentice"
   ClientHeight    =   5490
   ClientLeft      =   1035
   ClientTop       =   2070
   ClientWidth     =   6390
   Height          =   6180
   Icon            =   SA_SETUP.FRX:0000
   Left            =   975
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5490
   ScaleWidth      =   6390
   Top             =   1440
   Width           =   6510
   Begin CommonDialog CMDialog1
      Left            =   5640
      Top             =   5040
   End
   Begin TextBox AppName
      Height          =   285
      Left            =   2280
      TabIndex        =   3
      Top             =   480
      Width           =   3855
   End
   Begin PictureBox Drop
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   4080
      Picture         =   SA_SETUP.FRX:0302
      ScaleHeight     =   495
      ScaleWidth      =   495
      TabIndex        =   8
      Top             =   5040
      Visible         =   0   'False
      Width           =   495
   End
   Begin PictureBox NoDrop
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   3480
      Picture         =   SA_SETUP.FRX:0604
      ScaleHeight     =   495
      ScaleWidth      =   495
      TabIndex        =   7
      Top             =   5040
      Visible         =   0   'False
      Width           =   495
   End
   Begin Timer Timer1
      Interval        =   100
      Left            =   5160
      Top             =   5040
   End
   Begin DirListBox Dir1
      Height          =   1380
      Left            =   240
      TabIndex        =   1
      Top             =   1200
      Width           =   1815
   End
   Begin DriveListBox Drive1
      Height          =   315
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   1815
   End
   Begin FileListBox File1
      DragIcon        =   SA_SETUP.FRX:0906
      Height          =   2175
      Left            =   240
      MultiSelect     =   2  'Extended
      TabIndex        =   2
      Top             =   3000
      Width           =   1815
   End
   Begin ListBox IList
      DragIcon        =   SA_SETUP.FRX:0C08
      Height          =   1005
      Index           =   2
      Left            =   2280
      MultiSelect     =   2  'Extended
      Sorted          =   -1  'True
      TabIndex        =   6
      Top             =   4080
      Width           =   3855
   End
   Begin ListBox IList
      DragIcon        =   SA_SETUP.FRX:0F0A
      Height          =   1005
      Index           =   1
      Left            =   2280
      MultiSelect     =   2  'Extended
      Sorted          =   -1  'True
      TabIndex        =   5
      Top             =   2760
      Width           =   3855
   End
   Begin ListBox IList
      DragIcon        =   SA_SETUP.FRX:120C
      Height          =   1395
      Index           =   0
      Left            =   2280
      MultiSelect     =   2  'Extended
      Sorted          =   -1  'True
      TabIndex        =   4
      Top             =   1080
      Width           =   3855
   End
   Begin Label Label7
      Caption         =   "Application Name:"
      Height          =   255
      Left            =   2280
      TabIndex        =   15
      Top             =   240
      Width           =   2295
   End
   Begin Label Label6
      Caption         =   "Files:"
      Height          =   255
      Left            =   240
      TabIndex        =   14
      Top             =   2760
      Width           =   1215
   End
   Begin Label Label5
      Caption         =   "Directory:"
      Height          =   255
      Left            =   240
      TabIndex        =   13
      Top             =   960
      Width           =   1215
   End
   Begin Label Label4
      Caption         =   "Drive:"
      Height          =   255
      Left            =   240
      TabIndex        =   12
      Top             =   240
      Width           =   1215
   End
   Begin Label Label3
      Caption         =   "System Directory:"
      Height          =   255
      Left            =   2280
      TabIndex        =   11
      Top             =   3840
      Width           =   2295
   End
   Begin Label Label2
      Caption         =   "Windows Directory:"
      Height          =   255
      Left            =   2280
      TabIndex        =   10
      Top             =   2520
      Width           =   2295
   End
   Begin Label Label1
      Caption         =   "Application Directory:"
      Height          =   255
      Left            =   2280
      TabIndex        =   9
      Top             =   840
      Width           =   2295
   End
   Begin Menu MenuFile
      Caption         =   "&File"
      Begin Menu MenuFileOpen
         Caption         =   "&Open"
      End
      Begin Menu MenuFileClose
         Caption         =   "&Close"
      End
      Begin Menu MenuFileSave
         Caption         =   "&Save"
      End
      Begin Menu MenuFileSaveAs
         Caption         =   "Save &As"
      End
      Begin Menu sep1
         Caption         =   "-"
      End
      Begin Menu MenuFileExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu MenuCreateDisk
      Caption         =   "Create Disk!"
      Enabled         =   0   'False
   End
   Begin Menu MenuHelp
      Caption         =   "&Help"
      Begin Menu MenuHelpAbout
         Caption         =   "&About Setup Apprentice ..."
      End
   End
Option Explicit
Dim SetupFilename As String
Dim fChanged As Integer
Dim StartDrag As Integer
Dim DragStart As Integer
Dim DragCount As Integer
Sub AppName_Change ()
    SetFormCaption
    MenuCreateDisk.Enabled = Len(AppName.Text)
End Sub
Function CheckSave () As Integer
    If fChanged Then
    End If
    CheckSave = True
End Function
Sub Dir1_Change ()
    File1.Path = Dir1.Path
End Sub
Sub Dir1_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub
Sub Drive1_Change ()
    Dir1.Path = Drive1.Drive
End Sub
Sub Drive1_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub
Sub File1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (Button = 1) And File1.ListIndex <> -1 Then
        StartDrag = True
        DragStart = -1
        Timer1.Enabled = True
    End If
End Sub
Sub File1_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (Button = 1) Then StartDrag = False: File1.Drag 0
End Sub
Sub Form_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub
Sub Form_Load ()
    SetupClear
    SetFormCaption
End Sub
Sub Form_Unload (Cancel As Integer)
    If CheckSave() Then End
End Sub
Sub IList_DragDrop (Index As Integer, Source As Control, X As Single, Y As Single)
    Dim fAdd As Integer
    Dim I As Integer
    Dim J As Integer
    Dim N As Integer
    Dim S As String
    Dim DirPath As String
    fChanged = True
    If (DragStart <> Index) Then
        If (DragStart = -1) Then
            N = File1.ListCount
            If Right$(Dir1.Path, 1) = "\" Then
                DirPath = Dir1.Path
            Else
                DirPath = Dir1.Path & "\"
            End If
        Else
            N = IList(DragStart).ListCount
        End If
        For I = N - 1 To 0 Step -1
            S = ""
            If (DragStart = -1) Then
                If File1.Selected(I) Then S = DirPath & File1.List(I)
            ElseIf IList(DragStart).Selected(I) Then
                S = IList(DragStart).List(I)
                IList(DragStart).RemoveItem I
            End If
            If Len(S) Then
                fAdd = True
                For J = 0 To IList(Index).ListCount - 1
                    If S = IList(Index).List(J) Then
                        fAdd = False
                        Exit For
                    End If
                Next J
                If fAdd Then IList(Index).AddItem S
            End If
        Next I
    End If
End Sub
Sub IList_MouseDown (Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim I As Integer
    If (Button = 1) And IList(Index).ListIndex <> -1 Then
        StartDrag = True
        DragStart = Index
        Timer1.Enabled = True
    End If
    If (Button = 2) Then
        MsgBox Format$(Y)
    End If
End Sub
Sub IList_MouseUp (Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then StartDrag = False: IList(Index).Drag 0
End Sub
Sub Label1_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub
Sub Label2_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub
Sub Label3_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub
Sub Label4_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub
Sub Label5_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub
Sub Label6_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub
Sub MenuCreateDisk_Click ()
    Form1.Hide
    Form3.Show 1
    Form1.Show
End Sub
Sub MenuFileClose_Click ()
    If CheckSave() Then SetupClear
End Sub
Sub MenuFileExit_Click ()
    If CheckSave() Then End
End Sub
Sub MenuFileOpen_Click ()
    On Error GoTo NoOpen
    CMDialog1.Filename = "*.SA"
    CMDialog1.Flags = &H9804
    CMDialog1.Filter = "Setup Assitant (*.SA)|*.SA|All Files (*.*)|*.*"
    CMDialog1.CancelError = True
    CMDialog1.Action = 1
    OpenSetup CMDialog1.Filename
    SetupFilename = CMDialog1.Filename
    Call SetFormCaption
    GoTo OpenDone
NoOpen:
    Resume OpenDone
OpenDone:
    On Error GoTo 0
End Sub
Sub MenuFileSave_Click ()
    If AppName.Text = "" Then
        Beep
        MsgBox "You need to fill in the Application Name.", 48, "Save File"
    ElseIf SetupFilename = "" Then
        Call MenuFileSaveAs_Click
    Else
        SaveSetup SetupFilename
    End If
End Sub
Sub MenuFileSaveAs_Click ()
    Dim I As Integer
    Dim S As String
    Dim C As String
    If AppName.Text = "" Then
        Beep
        MsgBox "You need to fill in the Application Name.", 48, "Save File"
        Exit Sub
    End If
    On Error GoTo NoSave
    If SetupFilename <> "" Then
        CMDialog1.Filename = "*.SA"
    Else
        S = ""
        For I = 1 To Len(AppName.Text)
            C = Mid$(UCase$(AppName.Text), I, 1)
            If ((C >= "A") And (C <= "Z")) Then S = S & Mid$(AppName.Text, I, 1)
        Next I
        CMDialog1.Filename = Left$(S, 8) & ".SA"
    End If
    CMDialog1.Flags = &H9804
    CMDialog1.Filter = "Setup Assitant (*.SA)|*.SA|All Files (*.*)|*.*"
    CMDialog1.CancelError = True
    CMDialog1.Action = 2
    SetupFilename = CMDialog1.Filename
    Call SetFormCaption
    SaveSetup CMDialog1.Filename
    GoTo SaveDone
NoSave:
    Resume SaveDone
SaveDone:
    On Error GoTo 0
End Sub
Sub MenuHelpAbout_Click ()
    Form2.Show 1
End Sub
Sub OpenSetup (ByVal Filename As String)
    Dim S As String
    SetupClear
    SetupFilename = Filename
    MenuCreateDisk.Enabled = False
    Open Filename For Input Access Read As #1
    While Not EOF(1)
        Input #1, S
        If Left$(S, 8) = "AppName" Then
            AppName.Text = Mid$(S, 9)
            MenuCreateDisk.Enabled = Len(AppName.Text)
        ElseIf Left$(S, 7) = "WinDir " Then
            IList(1).AddItem Mid$(S, 8)
        ElseIf Left$(S, 7) = "SysDir " Then
            IList(2).AddItem Mid$(S, 8)
        ElseIf Left$(S, 7) = "AppDir " Then
            IList(0).AddItem Mid$(S, 8)
        ElseIf Left$(S, 6) = "Drive " Then
            Drive1.Drive = Mid$(S, 7)
        ElseIf Left$(S, 4) = "Dir " Then
            Dir1.Path = Mid$(S, 5)
            File1.Path = Mid$(S, 5)
        End If
    Wend
    Close #1
End Sub
Sub SetFormCaption ()
    Dim S As String
    S = "Setup Apprentice - "
    If Len(AppName.Text) Then
        S = S & AppName.Text
    Else
        S = S & "New Application"
    End If
    If Len(SetupFilename) Then
        S = S & " [" & SetupFilename & "]"
    Else
        S = S & " [UNKNOWN.SA]"
    End If
    Form1.Caption = S
End Sub
Sub SetupClear ()
    fChanged = False
    AppName.Text = ""
    SetupFilename = ""
    IList(0).Clear
    IList(1).Clear
    IList(2).Clear
End Sub
Sub Timer1_Timer ()
    Dim I As Integer
    Dim N As Integer
    If StartDrag Then
        Timer1.Enabled = False
        N = 0
        Select Case DragStart
            Case -1:
                For I = 0 To File1.ListCount - 1
                    If File1.Selected(I) Then N = N + 1
                Next I
            Case Else:
                For I = 0 To IList(DragStart).ListCount - 1
                    If IList(DragStart).Selected(I) Then N = N + 1
                Next I
        End Select
        If N Then
            Select Case DragStart
                Case -1:
                    File1.DragIcon = Drop.Picture
                    File1.Drag 1
                Case Else:
                    IList(DragStart).DragIcon = Drop.Picture
                    IList(DragStart).Drag 1
            End Select
        End If
        StartDrag = False
    End If
End Sub